home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / mfboid1s / MFBOID1S.ZIP / ufrmBoids.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-08  |  16.3 KB  |  544 lines
  1. unit ufrmBoids;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, Menus, ComCtrls, IniFiles,StrFunctions,
  8.   uBoids, uBoidEngine, uTMovable;
  9.  
  10. type
  11.   TfrmBoids = class(TForm)
  12.     Panel1: TPanel;
  13.     lblBoidsPerSecond: TLabel;
  14.     tmrBoidCount: TTimer;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     txtNumberOfBoids: TEdit;
  18.     MainMenu1: TMainMenu;
  19.     File1: TMenuItem;
  20.     Exit1: TMenuItem;
  21.     Startboids1: TMenuItem;
  22.     Stopboids1: TMenuItem;
  23.     Help1: TMenuItem;
  24.     About1: TMenuItem;
  25.     Causesometurmoil1: TMenuItem;
  26.     N2: TMenuItem;
  27.     Obstacles1: TMenuItem;
  28.     Clearallobstacles1: TMenuItem;
  29.     chkObstacle: TCheckBox;
  30.     Hideobstacles1: TMenuItem;
  31.     Panel2: TPanel;
  32.     Label3: TLabel;
  33.     tbMaxSpeed: TTrackBar;
  34.     Label4: TLabel;
  35.     tbSpeedChange: TTrackBar;
  36.     Label5: TLabel;
  37.     tbSensorRange: TTrackBar;
  38.     Label6: TLabel;
  39.     tbOptimalDistance: TTrackBar;
  40.     Label7: TLabel;
  41.     tbTooClose: TTrackBar;
  42.     Label9: TLabel;
  43.     tbTurnRate: TTrackBar;
  44.     tbLineLength: TTrackBar;
  45.     Label10: TLabel;
  46.     cmdAdjustBoidCount: TButton;
  47.     cmdSaveSettings: TButton;
  48.     cboBoidStyles: TComboBox;
  49.     cmdEraseStyle: TButton;
  50.     chkBlanking: TCheckBox;
  51.     Image1: TImage;
  52.     Label8: TLabel;
  53.     tbStayInCenter: TTrackBar;
  54.     procedure cmdStartClick(Sender: TObject);
  55.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  56.     procedure FormShow(Sender: TObject);
  57.     procedure cmdStopClick(Sender: TObject);
  58.     procedure tmrBoidCountTimer(Sender: TObject);
  59.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  60.       Y: Integer);
  61.     procedure Image1Click(Sender: TObject);
  62.     procedure Image1DblClick(Sender: TObject);
  63.     procedure chkObstacleClick(Sender: TObject);
  64.     procedure About1Click(Sender: TObject);
  65.     procedure Exit1Click(Sender: TObject);
  66.     procedure Clearallobstacles1Click(Sender: TObject);
  67.     procedure Causesometurmoil1Click(Sender: TObject);
  68.     procedure Hideobstacles1Click(Sender: TObject);
  69.     procedure tbSpeedChangeChange(Sender: TObject);
  70.     procedure tbMaxSpeedChange(Sender: TObject);
  71.     procedure tbSensorRangeChange(Sender: TObject);
  72.     procedure tbOptimalDistanceChange(Sender: TObject);
  73.     procedure tbTooCloseChange(Sender: TObject);
  74.     procedure tbTurnRateChange(Sender: TObject);
  75.     procedure tbLineLengthChange(Sender: TObject);
  76.     procedure cmdAdjustBoidCountClick(Sender: TObject);
  77.     procedure cmdSaveSettingsClick(Sender: TObject);
  78.     procedure cboBoidStylesChange(Sender: TObject);
  79.     procedure cmdEraseStyleClick(Sender: TObject);
  80.     procedure chkBlankingClick(Sender: TObject);
  81.     procedure tbStayInCenterChange(Sender: TObject);
  82.     procedure Button1Click(Sender: TObject);
  83.   private
  84.     { Private declarations }
  85.   public
  86.     { Public declarations }
  87.     bRun                : boolean;
  88.     procedure ReadSettingsFromIniToTrackBars;
  89.     procedure ReadSettingsFromTrackBars;
  90.     procedure SaveSettingsFromTrackBarsToIni;
  91.     procedure StartBoidEngine(bDirect : boolean);
  92.   end;
  93.  
  94.   TCursorBoid = class(TBoid)
  95.     function PrepareToMove(ClosestBoids : TList;ClosestObstacle : TMovable; Canvas : TCanvas) : boolean;override;
  96.     procedure Move(Canvas : TCanvas);override;
  97.     procedure TurnLeft(delta : real);override;
  98.     procedure TurnRight(delta : real);override;
  99.   end;
  100.  
  101.   procedure ClearArena(Canvas : TCanvas);
  102.  
  103.  
  104. var
  105.   frmBoids            : TfrmBoids;
  106.   BoidEngine          : TBoidEngine;
  107.   iBoidPerSecondCount : integer;
  108.   iGenerationCounter    : integer;
  109.   bPlaceObstacle            : boolean;
  110.   MouseX,MouseY       : integer;
  111.   bStarted                        : boolean;
  112.   CursorBoid          : TCursorBoid;
  113.   IniFile                            : TIniFile;
  114.   OutputCanvas                 : TCanvas;
  115.   bDirectDraw                    : boolean;
  116.  
  117. implementation
  118.  
  119. uses ufrmAbout;
  120.  
  121. {$R *.DFM}
  122. //******************************************************************************
  123. function TCursorBoid.PrepareToMove(ClosestBoids : TList;ClosestObstacle : TMovable; Canvas : TCanvas):boolean;
  124. begin
  125. end;
  126.  
  127. //******************************************************************************
  128. procedure TCursorBoid.Move(Canvas : TCanvas);
  129. begin
  130.   x := MouseX;
  131.   y := MouseY;
  132. end;
  133.  
  134. //******************************************************************************
  135. procedure TCursorBoid.TurnLeft(delta : real);
  136. begin
  137.   Dir := Dir - delta;
  138. end;
  139.  
  140. //******************************************************************************
  141. procedure TCursorBoid.TurnRight(delta : real);
  142. begin
  143.   Dir := Dir + delta;
  144. end;
  145.  
  146. //******************************************************************************
  147. procedure ClearArena(Canvas : TCanvas);
  148. begin
  149.     Canvas.Pen.Color := clBlack;
  150.   Canvas.Brush.Color := clBlack;
  151.     Canvas.FillRect(Canvas.ClipRect);
  152. end;
  153.  
  154. //******************************************************************************
  155. procedure TfrmBoids.ReadSettingsFromTrackBars;
  156. var
  157.     i : integer;
  158. begin
  159.   for i := 0 to ComponentCount -1 do
  160.      if (Components[I] is TTrackBar) then
  161.                 TTrackBar(Components[i]).OnChange(nil);
  162. end;
  163.  
  164. //******************************************************************************
  165. procedure TfrmBoids.ReadSettingsFromIniToTrackBars;
  166. var
  167.     i : integer;
  168.   iObsCount             : integer;
  169.   sSectionName         : string;
  170.   sObsString            : string;
  171.   x,y,size                : real;
  172.   iBCount                    : integer;
  173. begin
  174.   sSectionName := cboBoidStyles.Text;
  175.  
  176.   for i := 0 to ComponentCount -1 do
  177.       if (Components[I] is TTrackBar) then
  178.         TTrackBar(Components[I]).Position :=
  179.           IniFile.ReadInteger(sSectionName,TTrackBar(Components[I]).Name,TTrackBar(Components[I]).Position);
  180.  
  181.   ReadSettingsFromTrackBars;
  182.  
  183.   iBCount := IniFile.ReadInteger(sSectionName,'boidcount',25);
  184.   BoidEngine.AdjustMovableCount(iBCount);
  185.  
  186.   txtNumberOfBoids.Text := inttostr(iBCount);
  187.  
  188.   iObsCount := IniFile.ReadInteger(cboBoidStyles.Text,
  189.       'obstacle count', 0);
  190.  
  191.   if bRun and (iObsCount > 0) then with BoidEngine do
  192.   begin
  193.         while ObstacleList.Count <> 0 do
  194.       begin
  195.           TObstacle(ObstacleList[ObstacleList.Count-1]).Destroy;
  196.       ObstacleList.Delete(ObstacleList.Count-1);
  197.       end;
  198.  
  199.     for i := 1 to iObsCount do
  200.     begin
  201.       sObsString := IniFile.ReadString(cboBoidStyles.Text,
  202.               'obstacle ' + IntToStr(i-1),'1,1');
  203.  
  204.       x := StrToFloat(GetBefore(',',sObsString));
  205.       sObsString := GetAfter(',',sObsString);
  206.             y := StrToFloat(GetBefore(',',sObsString));
  207.       size := StrToFloat(GetAfter(',',sObsString));
  208.  
  209.       ObstacleList.Add(TObstacle.Create(trunc(x),trunc(y),trunc(size),clYellow,Canvas));
  210.     end;
  211.   end;
  212. end;
  213.  
  214. //******************************************************************************
  215. procedure TfrmBoids.SaveSettingsFromTrackBarsToIni;
  216. var
  217.     i : integer;
  218.   sSectionName : string;
  219. begin
  220.   sSectionName := cboBoidStyles.Text;
  221.  
  222.   for i := 0 to ComponentCount -1 do
  223.          if (Components[I] is TTrackBar) then
  224.          IniFile.WriteInteger(sSectionName,TTrackBar(Components[I]).Name,TTrackBar(Components[I]).Position);
  225.  
  226.   IniFile.WriteInteger(sSectionName,'boidcount',BoidEngine.MovableList.Count-1);
  227.  
  228.   if bRun then
  229.   begin
  230.       for i := 0 to BoidEngine.ObstacleList.Count - 1 do
  231.     begin
  232.       IniFile.WriteString(cboBoidStyles.Text,
  233.               'obstacle ' + IntToStr(i),
  234.               FloatToStr(TObstacle(BoidEngine.ObstacleList[i]).X)+','+
  235.         FloatToStr(TObstacle(BoidEngine.ObstacleList[i]).Y) + ',' +
  236.         FloatToStr(TObstacle(BoidEngine.ObstacleList[i]).Size) );
  237.     end;
  238.   end;
  239.   IniFile.WriteInteger(cboBoidStyles.Text,
  240.       'obstacle count',
  241.       BoidEngine.ObstacleList.Count);
  242. end;
  243.  
  244. //******************************************************************************
  245. procedure TfrmBoids.StartBoidEngine(bDirect : boolean);
  246. begin
  247.     if frmBoids.bRun then exit;
  248.   bDirectDraw := bDirect;
  249.  
  250. {    if bDirectDraw then
  251.       OutputCanvas := frmDirectDraw.DGCScreen1.Back.Canvas
  252.   else //}
  253.       OutputCanvas := frmBoids.Image1.Canvas;
  254.  
  255.   BoidEngine := TBoidEngine.Create(StrToInt(frmBoids.txtNumberOfBoids.Text),OutputCanvas);
  256.   BoidEngine.Application := Application;
  257.  
  258.   frmBoids.chkObstacleClick(nil);
  259.  
  260.   frmBoids.bRun := true;
  261.  
  262.   frmBoids.ReadSettingsFromIniToTrackBars;
  263.  
  264.   iBoidPerSecondCount := 0;
  265.   Canvas.Pen.Width := 1;
  266.  
  267.   while frmBoids.bRun do
  268.   begin
  269. {      if bDirectDraw then
  270.           OutputCanvas := frmDirectDraw.DGCScreen1.Back.Canvas
  271.     else}
  272.           OutputCanvas := frmBoids.Image1.Canvas;
  273.  
  274.       inc(iGenerationCounter);
  275.     iBoidPerSecondCount := iBoidPerSecondCount + BoidEngine.MovableList.Count;
  276.     BoidEngine.RunStep;
  277. {    if bDirectDraw then
  278.     begin
  279.         //This must be called to release the device context.
  280.         frmDirectDraw.DGCScreen1.Back.Canvas.Release;
  281.         frmDirectDraw.DGCScreen1.Flip;
  282.     end;}
  283.     Application.ProcessMessages;
  284.   end;
  285.  
  286.   BoidEngine.Destroy;
  287.   CursorBoid := TCursorBoid.Create(nil);
  288. end;
  289.  
  290. //******************************************************************************
  291. procedure TfrmBoids.cmdStartClick(Sender: TObject);
  292. begin
  293.     StartBoidEngine(false);
  294. end;
  295.  
  296. //******************************************************************************
  297. procedure TfrmBoids.cmdStopClick(Sender: TObject);
  298. begin
  299.   bRun := false;
  300. end;
  301.  
  302. //******************************************************************************
  303. procedure TfrmBoids.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  304. begin
  305.     Halt;
  306. end;
  307.  
  308. //******************************************************************************
  309. procedure TfrmBoids.FormShow(Sender: TObject);
  310. begin
  311.   CursorBoid := TCursorBoid.Create(nil);
  312.   IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'boids.ini');
  313.  
  314.   IniFile.ReadSections(cboBoidStyles.Items);
  315.   cboBoidStyles.ItemIndex := 0;
  316. end;
  317.  
  318. //******************************************************************************
  319. procedure TfrmBoids.tmrBoidCountTimer(Sender: TObject);
  320. begin
  321.     if not bStarted then
  322.   begin
  323.         // Set off the boids!
  324.     StartBoidEngine(false);
  325.       bStarted := true;
  326.   end;
  327.  
  328.   if not bDirectDraw then
  329.       lblBoidsPerSecond.Caption := IntToStr(iBoidPerSecondCount);
  330.   iBoidPerSecondCount := 0;
  331.  
  332.   if (BoidEngine <> nil) then iGenerationCounter := 0;
  333. end;
  334.  
  335. //******************************************************************************
  336. procedure TfrmBoids.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  337.   Y: Integer);
  338. begin
  339.   MouseX := x;
  340.   MouseY := y;
  341. end;
  342.  
  343. //******************************************************************************
  344. procedure TfrmBoids.Image1Click(Sender: TObject);
  345. var
  346.     NewBoid : TBoid;
  347.   NewObstacle : TObstacle;
  348. begin
  349.   CursorBoid.TurnLeft(1);
  350.   if BoidEngine = nil then exit;
  351.  
  352.     NewObstacle := TObstacle.Create(MouseX,MouseY,20,clYellow,Canvas);
  353.   BoidEngine.ObstacleList.Add(NewObstacle);
  354.  
  355.   bPlaceObstacle := false;
  356. end;
  357.  
  358. //******************************************************************************
  359. procedure TfrmBoids.Image1DblClick(Sender: TObject);
  360. begin
  361.   CursorBoid.TurnRight(1);
  362.   CursorBoid.TurnRight(1);
  363. end;
  364.  
  365. //******************************************************************************
  366. procedure TfrmBoids.cmdAdjustBoidCountClick(Sender: TObject);
  367. var
  368.   iNewCount : integer;
  369. begin
  370.     if not bRun then exit;
  371.   iNewCount := StrToInt(txtNumberOfBoids.Text);
  372.     BoidEngine.AdjustMovableCount(iNewCount);
  373. end;
  374.  
  375. //******************************************************************************
  376. procedure TfrmBoids.chkObstacleClick(Sender: TObject);
  377. var
  378.     i : integer;
  379. begin
  380.     if (BoidEngine <> nil) then
  381.       for i := 0 to BoidEngine.ObstacleList.Count - 1 do
  382.       TObstacle(BoidEngine.ObstacleList[i]).bActive := (chkObstacle.State = cbChecked);
  383. end;
  384.  
  385. //******************************************************************************
  386. procedure TfrmBoids.About1Click(Sender: TObject);
  387. begin
  388.     frmAbout.Show;
  389. end;
  390.  
  391. //******************************************************************************
  392. procedure TfrmBoids.Exit1Click(Sender: TObject);
  393. begin
  394.     Halt;
  395. end;
  396.  
  397. //******************************************************************************
  398. procedure TfrmBoids.Clearallobstacles1Click(Sender: TObject);
  399. var
  400.     i : integer;
  401. begin
  402.     if (BoidEngine <> nil) then
  403.   begin
  404.       for i := 0 to BoidEngine.ObstacleList.Count - 1 do
  405.           TObstacle(BoidEngine.ObstacleList[i]).Destroy;
  406.  
  407.         BoidEngine.ObstacleList.Clear;
  408.   end;
  409. end;
  410.  
  411. //******************************************************************************
  412. procedure TfrmBoids.Causesometurmoil1Click(Sender: TObject);
  413. var
  414.     i : integer;
  415. begin
  416.     if not bRun then exit;
  417.  
  418.     for i := 0 to BoidEngine.MovableList.Count - 1 do
  419.         TBoid(BoidEngine.MovableList[i]).Dir := random(627) / 100.0 - pi;
  420. end;
  421.  
  422. //******************************************************************************
  423. procedure TfrmBoids.Hideobstacles1Click(Sender: TObject);
  424. begin
  425.     if chkObstacle.State = cbChecked then
  426.       chkObstacle.State := cbUnChecked
  427.   else
  428.       chkObstacle.State := cbChecked;
  429. end;
  430.  
  431. //******************************************************************************
  432. procedure TfrmBoids.tbSpeedChangeChange(Sender: TObject);
  433. begin
  434.     if BoidEngine = nil then exit;
  435.     BoidEngine.MaxSpeedChange := tbSpeedChange.Position/100;
  436.   BoidEngine.CopySettingsToAllBoids;
  437. end;
  438.  
  439. //******************************************************************************
  440. procedure TfrmBoids.tbMaxSpeedChange(Sender: TObject);
  441. begin
  442.     if BoidEngine = nil then exit;
  443.     BoidEngine.MaxSpeed := tbMaxSpeed.Position/2;
  444.   BoidEngine.CopySettingsToAllBoids;
  445. end;
  446.  
  447. //******************************************************************************
  448. procedure TfrmBoids.tbSensorRangeChange(Sender: TObject);
  449. begin
  450.     if BoidEngine = nil then exit;
  451.     BoidEngine.SensorDistance := tbSensorRange.Position;
  452.   BoidEngine.CopySettingsToAllBoids;
  453. end;
  454.  
  455. //******************************************************************************
  456. procedure TfrmBoids.tbOptimalDistanceChange(Sender: TObject);
  457. begin
  458.     if BoidEngine = nil then exit;
  459.     BoidEngine.OptimalDistance := tbOptimalDistance.Position;
  460.   BoidEngine.CopySettingsToAllBoids;
  461. end;
  462.  
  463. procedure TfrmBoids.tbStayInCenterChange(Sender: TObject);
  464. begin
  465.     if BoidEngine = nil then exit;
  466.     BoidEngine.StayInCenter := tbStayInCenter.Position/10;
  467.   BoidEngine.CopySettingsToAllBoids;
  468. end;
  469.  
  470. //******************************************************************************
  471. procedure TfrmBoids.tbTooCloseChange(Sender: TObject);
  472. begin
  473.     if BoidEngine = nil then exit;
  474.     BoidEngine.TooClose := tbTooClose.Position;
  475.   BoidEngine.ReallyClose := BoidEngine.TooClose - 2;
  476.   BoidEngine.CopySettingsToAllBoids;
  477. end;
  478.  
  479. {procedure TfrmBoids.tbReallyCloseChange(Sender: TObject);
  480. begin
  481.     if BoidEngine = nil then exit;
  482.     BoidEngine.ReallyClose := tbReallyClose.Position;
  483.   BoidEngine.CopySettingsToAllBoids;
  484. end;}
  485.  
  486. //******************************************************************************
  487. procedure TfrmBoids.tbTurnRateChange(Sender: TObject);
  488. begin
  489.     if BoidEngine = nil then exit;
  490.     BoidEngine.MaxTurnSpeed := tbTurnRate.Position/100;
  491.   BoidEngine.CopySettingsToAllBoids;
  492. end;
  493.  
  494. //******************************************************************************
  495. procedure TfrmBoids.tbLineLengthChange(Sender: TObject);
  496. begin
  497.     if BoidEngine = nil then exit;
  498.     BoidEngine.LineLength := tbLineLength.Position;
  499.   BoidEngine.CopySettingsToAllBoids;
  500. end;
  501.  
  502. //******************************************************************************
  503. procedure TfrmBoids.cmdSaveSettingsClick(Sender: TObject);
  504. var
  505.     i : integer;
  506. begin
  507.     SaveSettingsFromTrackBarsToIni;
  508.   IniFile.ReadSections(cboBoidStyles.Items);
  509. end;
  510.  
  511. //******************************************************************************
  512. procedure TfrmBoids.cboBoidStylesChange(Sender: TObject);
  513. begin
  514.     ReadSettingsFromIniToTrackBars;
  515. end;
  516.  
  517. //******************************************************************************
  518. procedure TfrmBoids.cmdEraseStyleClick(Sender: TObject);
  519. begin
  520.     IniFile.EraseSection(cboBoidStyles.Text);
  521.     //IniFile.ReadSections(cboBoidStyles.Items);
  522.   cboBoidStyles.Items.Delete(cboBoidStyles.ItemIndex);
  523. end;
  524.  
  525. //******************************************************************************
  526. procedure TfrmBoids.chkBlankingClick(Sender: TObject);
  527. begin
  528.     if BoidEngine <> nil then
  529.       BoidEngine.bBlanking := chkBlanking.Checked;
  530. end;
  531.  
  532. procedure TfrmBoids.Button1Click(Sender: TObject);
  533. begin
  534. {    bRun := false;
  535.   Application.ProcessMessages;
  536.   Application.ProcessMessages;
  537.   Application.ProcessMessages;
  538.  
  539.     frmDirectDraw.Show;
  540.   StartBoidEngine(true);}
  541. end;
  542. end.
  543.  
  544.